perm filename ADISP.F4[1,MUS] blob
sn#081805 filedate 1974-01-15 generic text, type T, neo UTF8
00100 COMMENT ā VALID 00006 PAGES
00200 C REC PAGE DESCRIPTION
00300 C00001 00001
00400 C00002 00002 SUBROUTINE DISP(ZCAR,ZMOD,ZZI1,ZZI2)
00500 C00004 00003 IY=AMP(1)*100.+300.
00600 C00006 00004 CALL ALINE(-400,0,100,0)
00700 C00008 00005 GO TO 60
00800 C00010 00006 102 NC=NC+1
00900 C00011 ENDMK
01000 Cā;
00100 SUBROUTINE DISP(ZCAR,ZMOD,ZZI1,ZZI2)
00200 DIMENSION XFREQ(2)
00300 COMMON FREQ(3,0/50,100),FUNC(100),AMP(100),II(1),IJJ(4000)
00400 CALL DPYTYP(-400,6,1)
00500 302 TYPE 303
00600 303 FORMAT(' CR OR 1 TO CHANGE AMP FUNC'/)
00700 ACCEPT 304,IFUN
00800 304 FORMAT(I)
00900 GO TO (3005,306),IFUN+1
01000 306 TYPE 310
01100 310 FORMAT(' NOW AMPLITUDE FUNCTION'/)
01200 CALL GEN(AMP)
01300 3005 TYPE 607
01400 607 FORMAT('+CR OR 1 TO READ SPECTRUM FROM DSK'/)
01500 ACCEPT 304,IFUN
01600 IF(IFUN.EQ.1)CALL DSKFUN
01700 305 MIBASE=99999
01800 MIFREQ=-400
01900 C309 NND=ZZND
02000 309 NND=XXND
02100 TYPE 4001,NND
02200 4001 FORMAT('+NO OF LINES/100 (TIME SLICES) MINUS BOUNDS=',I7/)
02300 TYPE 103
02400 103 FORMAT('+TYPE CR OR -1 FOR NONE OR NEW NUMBER OF LINES/100='/)
02500 ACCEPT 702,XXND
02600 ND=XXND
02700 IF(XXND.NE.0.0)ZZND=XXND
02800 IF(XXND.LT.0.0)ND=0
02900 IF(XXND.GT.0.0)ND=100./(XXND+1.)
03000 TYPE 4003,SCALE
03100 4003 FORMAT('+SCALE NOW =',F7.1/)
03200 TYPE 700
03300 700 FORMAT('+TYPE CR OR DISPLAY SCALE='/)
03400 ACCEPT 702,SCAL
03500 IF(SCAL.NE.0.0)SCALE=SCAL
03600 702 FORMAT(F)
03700 104 FORMAT (I)
03800 CALL DPYSET(1,IJJ,4000)
03900 CALL CLRPOG(1)
04000 CALL DPYBIG(5)
04100 CALL DPYTXT(-300,450,'DYNAMIC FM SPECTRUM',4)
04200 CALL ALINE(-400,300,-200,300)
04300 CALL ALINE(-400,400,-400,300)
04400 CALL DPYBIG(1)
04500 CALL DPYTXT(-380,280,'AMP FUNCTION',3)
04600 CALL DPYTXT(-440,400,'1.0',1)
04700
04800
04900
00100 IY=AMP(1)*100.+300.
00200 IX=-400
00300 CALL AIVECT(IX,IY)
00400 DO 401 I=2,100
00500 IX=IX+2
00600 IY=AMP(I)*100.+300.
00700 401 CALL AVECT(IX,IY)
00800 CALL ALINE(100,300,300,300)
00900 CALL ALINE(100,400,100,300)
01000 CALL DPYTXT(120,280,'INDEX FUNCTION',3)
01100 CALL DPYTXT(30,400,'IDX2=',1)
01200 CALL DPYTXT(30,300,'IDX1=',1)
01300 IY=AMP(1)*100.+300.
01400 IX=100
01500 CALL AIVECT(IX,IY)
01600 DO 402 I=2,100
01700 IY=FUNC(I)*100.+300.
01800 IX=IX+2
01900 402 CALL AVECT(IX,IY)
02000 CALL DPYBIG(3)
02100 71 FORMAT(A5)
02200 CALL DPYTXT(-400,-300,'CAR=',1)
02300 XCAR=ZCAR
02400 ENCODE(5,72,XXCAR)XCAR
02500 72 FORMAT(F5.1)
02600 CALL DPYTXT(-360,-300,XXCAR,1)
02700 CALL DPYTXT(-400,-320,'MOD=',1)
02800 XCAR=ZMOD
02900 ENCODE(5,72,XXCAR)XCAR
03000 CALL DPYTXT(-360,-320,XXCAR,1)
03100 CALL DPYTXT(-400,-340,'IDX1=',1)
03200 XI1T=ZZI1
03300 ENCODE(5,72,XXI1T)XI1T
03400 CALL DPYTXT(-360,-340,XXI1T,1)
03500 CALL DPYTXT(-400,-360,'IDX2=',1)
03600 XI2T=ZZI2
03700 ENCODE(5,72,XXI2T)XI2T
03800 CALL DPYTXT(-360,-360,XXI2T,1)
03900 CALL DPYBIG(1)
04000 CALL DPYTXT(60,300,XXI1T,1)
04100 CALL DPYTXT(60,400,XXI2T,1)
04200 CALL DPYBIG(3)
00100 CALL ALINE(-400,0,100,0)
00200 CALL ALINE(100,0,90,5)
00300 CALL ALINE(100,0,90,-5)
00400 CALL ALINE(-400,250,-400,0)
00500 CALL ALINE(-400,250,-395,240)
00600 CALL ALINE(-400,250,-405,240)
00700 CALL DPYTXT(-480,250,'Amp',1)
00800 CALL DPYBIG(1)
00900 CALL DPYTXT(-480,0,'0 Hz',1)
01000 CALL DPYBIG(3)
01100 CALL DPYTXT(115,0,'Time',1)
01200 IX=-400
01300 IY=-90
01400 M=10
01500 CALL DPYTXT(IX,IY,'F',1)
01600 IX=IX+M
01700 IY=IY-M
01800 CALL DPYTXT(IX,IY,'r',1)
01900 IX=IX+M
02000 IY=IY-M
02100 CALL DPYTXT(IX,IY,'e',1)
02200 IX=IX+M
02300 IY=IY-M
02400 CALL DPYTXT(IX,IY,'q',1)
02500 MAX=FREQ(1,50,1)
02600 DO 200 J=0,MAX
02700 KL=1
02800 50 IF(FREQ(1,J,KL).EQ.99999.)GO TO 100
02900 C IF((FREQ(1,J,KL).EQ.0.0).AND.(FREQ(3,J,KL).EQ.0.0))GO TO 100
03000 IX=ABS(FREQ(1,J,KL))*SCALE-400.
03100 ZZ=IX
03200 IY=(ZZ+400.)*(-1.)+250.*FREQ(2,J,KL)*AMP(1)
03300 BASE=(ZZ+400.)*(-1.)
03400 IBASE=BASE
03500 IF(MIBASE.GT.IBASE)MIBASE=IBASE
03600 CALL DPYBIG(1)
03700 IF(FREQ(3,J,KL).NE.0.0)GO TO 51
03800 CALL DPYTXT(IX-40,IBASE,'car',1)
00100 GO TO 60
00200 51 ZFREQ=FREQ(1,J,KL)
00300 ENCODE(7,52,XFREQ)ZFREQ
00400 52 FORMAT(F7.2)
00500 CALL DPYTXT(IX-60,IBASE,XFREQ,2)
00600 GO TO 60
00700 100 KL=KL+1
00800 IF(KL.GE.100)GO TO 200
00900 GO TO 50
01000 60 CALL AIVECT(IX,IBASE)
01100 IFREQ=IX
01200 IF(MIFREQ.LT.IFREQ)MIFREQ=IFREQ
01300 DO 61 NO=1,25
01400 CALL SVECT(5,0)
01500 61 CALL SIVECT(15,0)
01600 IF(KL.NE.1)IX=IX+(KL-1)*5
01700 CALL AIVECT(IX,IBASE)
01800 IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
01900 IF(FREQ(2,J,KL).NE.0.0)CALL AVECT(IX,IY)
02000 30 CONTINUE
02100 IF(ND.EQ.0)GO TO 36
02200 NC=KL
02300 IF(NC.LE.ND)GO TO 36
02400 31 NC=NC-ND
02500 IF(NC.GT.ND)GO TO 31
02600 36 IFLIP=1
02700 DO 199 KZ=KL+1,100
02800 IF(KL.GT.100)GO TO 199
02900 IF(FREQ(1,J,KZ).EQ.99999.)GO TO 199
03000 IX=IX+5
03100 IY=FREQ(2,J,KZ)*250.*AMP(KZ)+BASE
03200 IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
03300 IF(FREQ(1,J,KZ).EQ.0.0)IFLIP=-IFLIP
03400 IF(IFLIP.GT.0)GO TO 2001
03500 CALL AIVECT(IX,IY)
03600 GO TO 2002
03700 2001 CALL AVECT(IX,IY)
03800 2002 IF(ND.EQ.0)GO TO 199
03900 IF(FREQ(1,J,KZ).EQ.0.0)GO TO 199
04000 IF(NC.LT.ND)GO TO 102
04100 CALL AVECT(IX,IBASE)
04200 CALL AIVECT(IX,IY)
00100 102 NC=NC+1
00200 IF(NC.GT.ND)NC=1
00300 199 CONTINUE
00400 200 CONTINUE
00500 MIFREQ=MIFREQ+10
00600 MIBASE=MIBASE-10
00700 CALL ALINE(-400,0,MIFREQ,MIBASE)
00800 CALL ALINE(MIFREQ,MIBASE,MIFREQ-2,MIBASE+10)
00900 CALL ALINE(MIFREQ,MIBASE,MIFREQ-10,MIBASE+4)
01000 CALL DPYOUT(1)
01100 TYPE 603
01200 603 FORMAT(' TYPE CR TO FIN'/' 1 TO CHNG AMPF'/)
01300 TYPE 604
01400 604 FORMAT('+ 2 FOR VERT LINES AND SC DISP'/)
01500 TYPE 605
01600 605 FORMAT('+3 TO SAVE SPECTRUM ON DSK'/)
01700 ACCEPT 304,N
01800 IF(N.EQ.3)CALL DSKWRT
01900 GO TO (302,305),N
02000 CALL HYDPOG(1)
02100 II(1)=IJJ(2)+2
02200 CALL SAVB(II)
02300 RETURN
02400 END